BcdLoad.mesa 2-Sep-78 12:25:15 Page 1 

-- BcdLoad.mesa; edited by Johnsson on August 30, 1978 10:14 PM 

DIRECTORY 

BcdDefs: FROM "bcddefs". 
BcdBindDefs: FROM "bcdbinddef s". 
BcdControlDefs: FROM "bcdcontroldefs" . 
BcdErrorDefs: FROM "bcderrordef s", 
BcdFileDefs: FROM "bcdf iledef s". 
BcdHeapDefs: FROM "bcdheapdef s**, 
BcdTabDefs: FROM "bcdtabdef s", 
BcdTreeDefs: FROM "bcdtreedef s", 
BcdUtilDefs: FROM "bcdutildef s*\ 
MiscDefs: FROM "miscdef s". 
SegmentDefs: FROM "segmentdefs". 
StringDefs: FROM "stringdef s". 
TableDefs: FROM "tabledefs"; 

DEFINITIONS FROM BcdTreeDefs, BcdDefs. BcdTabDefs; 

BcdLoad: PROGRAM [data: BcdControlDefs. BinderData] 

IMPORTS BcdErrorDefs, BcdFileDefs, BcdHeapDefs, TableDefs, BcdTreeDefs, BcdUtilDefs, MiscDefs. Segmen 
**tDefs 

EXPORTS BcdBindDefs, BcdControlDefs ■ 

BEGIN 

CTIndex: TYPE - BcdDefs .CTIndex; CTNull: CTIndex « BcdDef s.CTNull ; 
MTIndex: TYPE - BcdDef s .MTIndex; MTNull: MTIndex » BcdDef s.MTNull ; 
IMPIndex: TYPE - BcdDef s.IMPIndex; IMPNull: IMPIndex » BcdDef s. IMPNull ; 
EXPIndex: TYPE « BcdDef s .EXPIndex; EXPNull: EXPIndex « BcdDef s . EXPNull ; 
FTIndex: TYPE = BcdDef s .FTIndex; FTNull: FTIndex = BcdDef s . FTNull ; 
HTIndex: TYPE - BcdTabDefs. HTIndex; HTNull: HTIndex » BcdTabDefs .HTNull ; 
STIndex: TYPE - BcdTabDefs. STIndex; STNull : STIndex « BcdTabDefs. STNull ; 
CXIndex: TYPE - BcdTabDefs .CXIndex; CXNull: CXIndex « BcdTabDefs. CXNull ; 

LoadError: PUBLIC SIGNAL ■ CODE; 

currentCx, loadCx: CXIndex; 

loadTree: BcdTreeDefs. Tree Index; 

loadExpi: EXPIndex; 

packSti: STIndex; 

currentCti: CTIndex; 

currentOp: InterfaceOp; 

tb, stb, cxb: TableDefs. TableBase; 

local Bases: BcdUtilDefs.BcdBases; 
1 imits: BcdUtilDef s.BcdLimits; 
bed: BcdUtilDefs. BcdBasePtr; 

Notifier: TableDefs .TableNotifier - 
BEGIN OPEN localBases; 
tb <- base[treetype]; 
stb <- base[sttype]; 
ctb ^ base[cttype]; 
cxb <- base[cxtype]; 
mtb <- base[mttype]; 
etb <- base[exptype]; 
itb ^ base[imptype]; 
ftb ^ base[fttype]; 
ntb ♦- base[nttype]; 
ssb <- LOOPHOLE[base[sstype]]; 
RETURN 
END; 

FileMapItem: TYPE » RECORD [old, new: FTIndex]; 
InterfaceOp: TYPE ■ {plus, then}; 
ExportAssigner: TYPE - PROCEDURE; 

error: PROCEDURE - BEGIN SIGNAL LoadError END; 

LoadRoot: PUBLIC PROCEDURE [root: TreeLink] - 
BEGIN 

TableDefs.AddNotify[Notifier]; 
bed <- ©localBases; 
loadExpi *■ EXPNull; 
currentCti ♦- CTNull; 
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currentOp ^ plus; 
currentParameters ♦- empty; 
ProcessExports <- VerifyExports; 
relocationHead ♦- NIL; 
loadTree ♦- nullTreelndex; 
loadCx 4- CXNull; 
WITH root SELECT FROM 
subtree -> 

BEGIN OPEN tb+index; 
SELECT name FROM 
source ■> 
BEGIN 

packSti ♦- F1ndPackSti[son2]; 
WITH son3 SELECT FROM 

subtree ■> LoadLocalConf ig[index. outer, HTNull]; 
ENDCASE -> error[]; 
END; 
ENDCASE ■> error[3; 
END; 
ENDCASE ■> error[]; 
TableDefs,DropNotify[Notifier]; 
RETURN 
END; 

FindPackSti: PROCEDURE [t: TreeLink] RETURNS [STIndex] - 
BEGIN 

IF t ■ empty THEN RETURN[STNun]; 
WITH t SELECT FROM 

symbol -> RETURN[index]; 

subtree »> RETURN[FindPackSti[(tb+index) .sonl]]; 

ENDCASE -> error[3; 
END; 

currentParameters: TreeLink; 

BodyWalk: TreeScan ■ 
BEGIN 

savelndex: CARDINAL - data. textlndex; 
WITH t SELECT FROM 

symbol ■> LoadSti[index. HTNull]; 
subtree •■> 
BEGIN 

data, textlndex <- (tb+index) .sourceindex; 
SELECT (tb+index). name FROM 
list »> scanlist[t. BodyWalk]; 
item «> Loadltemft]; 
config => NULL; 
assign »> LoadAssign[index] ; 
plus, then »> LoadExpression[t]; 
module ■> 
BEGIN 

currentParameters ^ (tb+index) .son2; 
Lo ad I tem[( tb+index). sonl]; 
END; 
ENDCASE -> error[]; 
END; 
ENDCASE -> error[]; 
data. textlndex *- savelndex; 
RETURN 
END; 

LoadLocalConf ig: PROCEDURE [index: Treelndex. level: BcdBindDef s.RelocationType, name: HTIndex] 
BEGIN OPEN t:tb+index, newct: localBases.ctb+currentCti ; 
saveCx: CXIndex ■• currentCx; 
saveCti: CTIndex ■ currentCti; 
saveLhs: TreeLink ■ Ihs; 

saveAssigner: ExportAssigner » ProcessExports; 
saveName: NameRecord - data.currentname; 
savelndex: CARDINAL - data. textlndex; 

firstimport: IMPIndex » LOOPHOLE[TableDefs .TableBounds[imptype].size]; 
localRel: POINTER TO BcdRelocations; 
currentCx <- BcdUtilDefs.ContextForTree[t.son4]; 
currentCti ♦- TableDef s.Allocate[cttype.SIZE[CTRecord]]; 
Ihs <- empty; 

ProcessExports ♦- NormalExports; 
d'ata.currentname <- newct. name ^ NameForLink[t .son4]; 
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data.textlndex ♦• t.sourceindex; 

IF name ■ HTNull THEN newct .namedinstance ♦- FALSE 

ELSE 

BEGIN 

newct. namedinstance ♦• TRUE; 

BcdUtilDefs. Create I nstanceName[name, [conf ig[currentCti]]]; 

END; 
newct. file <- FTSelf; 
newct. conf ig <- saveCti; 
All ocat8Re1ocations[ level]; 
localRel <- rel ; 
localRel .parentcx <- saveCx; 
BodyWalk[t.son5]; 
ProcessExports ^ saveAssigner; 
Ihs ♦■ saveLhs; 

newct. control ♦- IF t.son3 - empty THEN MTNull ELSE ControlModuleForLink[t.son3]; 
loadTree ^ index; 
loadCx <- currentCx; 
currentCx ^ saveCx; 
ProcessExportsC]; 
currentCx ♦- loadCx; 

localRel . import <- TableDefs.TableBounds[imptype].size; 
localRel .dummygfi ♦- BcdUtilDefs. GetDummyGfi[0]; 
ProcessLocalImports[first import]; 

localRel . importLimit ♦- LOOPHOLE[TableDef s.TableBounds[imptype]. size]; 
loadTree ^ nul ITreelndex; 
loadCx 4- CXNull; 
currentCti ^ saveCti; 
currentCx ♦- saveCx; 
data.currentname ^ saveName; 
data.textlndex ^ savelndex; 
END; 

ControlModuleForLink: PROCEDURE [t: TreeLink] RETURNS [MTIndex] - 
BEGIN 

gfi: GFTIndex; 
FindModule: PROCEDURE [mti: MTIndex] RETURNS [BOOLEAN] ■ 

BEGIN RETURN[(localBases.mtb+mti).gfi - gfi] END; 
WITH t SELECT FROM 
symbol -> 
BEGIN 

WITH sistb+index SELECT FROM 
external "^ 

WITH m:s.map SELECT FROM 
module ■> RETURN[m.mti]; 
interface «> 

IF (localBases.etb+m.expi) .port « module THEN 
BEGIN 

gfi <- (localBases.etb+m.expi) .links[0].gfi ; 
limits. mt ♦- LOOPHOLE[TableDef s.TableBounds[mttype].size]; 
RETURN[EnumerateModules[ FindModule]]; 
END 
ELSE GOTO notvalid; 
ENDCASE -> GOTO notvalid; 
ENDCASE -> GOTO notvalid; 
EXITS notvalid -> 

BcdErrorDefs.ErrorHti[error, "is not valid as a CONTROL module"L, (stb+index) .hti]; 
END; 
ENDCASE "> error[]; 
RETURN[MTNull] 
END; 

NameForLink: PROCEDURE [t; TreeLink] RETURNS [NameRecord] - 
BEGIN 
WITH t SELECT FROM 

symbol -> RETURN[BcdUtilDef s.NameForSti[index]]; 

ENDCASE ■> error[]; 
END; 

NotLoadable: PROCEDURE [sti: STIndex] - 
BEGIN 
BcdErrorDefs.ErrorSti[error, 

"is not loadable (probably needs ""[]"")"L, sti]; 
RETURN 
END; 
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LoadStit PROCEDURE [st1: STIndex. name: HTIndex] ■ 
BEGIN 
BEGIN 

ENABLE BcdErrorDefs.GetSti -> RESUME[st1]; 
WITH s: stb+sti SELECT FROM 
external ■> 

WITH p:s SELECT FROM 

file ■> s.map ♦■ Load[sti, name]; 
instance ■> s.map ♦- Load[p.sti. name]; 
ENDCASE -> error[]; 
local ■> LoadLocalConf ig[s. info, inner, name]; 
ENDCASE ■> NotLoadable[sti]; 
END; 
END; 

FileForSti: PROCEDURE [sti: STIndex] RETURNS [FTIndex] ■ 
BEGIN 

IF sti - STNull THEN RETURN[FTNul1 ]; 
WITH s: stb+sti SELECT FROM 
unknown ■> RETURN[FTNun]; 
external -> 

WITH p:s SELECT FROM 
file ■> RETURN[p.fti]; 
instance »> RETURN[FileForSti[p.sti]]; 
ENDCASE »> error[]; 
ENDCASE -> error[]; 
END; 

FileForPortableltem: PROCEDURE [p: Portableltem] RETURNS [FTIndex] 
BEGIN 
WITH p SELECT FROM 

interface -> RETURN[MapFile[(bcd.etb+expi) .f ile]]; 

module «> RETURN[MapFile[(bcd.mtb+mti) .f ile]]; 

ENDCASE ■> error[]; 
END; 

DeclarePortableltem: PROCEDURE [sti: STIndex, p: Portableltem] ■ 
BEGIN 
WITH p SELECT FROM 

interface ■> Declarelnterface[sti , expi]; 

module -> DeclareModule[sti , mti]; 

ENDCASE -> error[]; 
END; 

Declarelnterface: PROCEDURE [sti: STIndex, eti: EXPIndex] ■ 
BEGIN 

fti: FTIndex <- MapFile[(bcd .etb+eti) .f ile]; 
WITH s:(stb+sti) SELECT FROM 
external ■> 
BEGIN 

s.map <r [interface[EXPNull]]; - 
WITH p:s SELECT FROM 
instance -> 

IF p. sti - STNull THEN s. pointer ^ file[fti] 
ELSE Declarelnterface[p.sti , eti]; 
file -> p. fti <- fti; 
ENDCASE »> error[]; 
END; 
unknown ■> 

(stb+sti) .body <- 

external[pointer: file[fti], map: [interface[EXPNull]]] ; 
ENDCASE -> error[]; 
END; 

DeclareModule: PROCEDURE [sti: STIndex, mti: MTIndex] ■ 
BEGIN 

fti: FTIndex; 

WITH s:(stb+sti) SELECT FROM 
external ■> 
BEGIN 

s.map ^ [module[MTNull]]; 
WITH p:s SELECT FROM 

instance ■> DeclareModule[p.sti , mti]; 
file -> p. fti <r MapFile[(bcd.mtb+mti).file]; 
ENDCASE -> error[]; 
END; 
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unknown ■> 
BEGIN 

fti 4- MapFne[(bcd.mtb+mti).file]: 
(stb+sti) .body <- 

external[pointer: file[fti], map:[modu1e[MTNu11]]]; 
END; 
ENDCASE "> error[]; 
END; 

currentCodeLinks: BOOLEAN; 

Loadltem: PROCEDURE [t: TreeLink] - 
BEGIN 

sti: STIndex; 
WITH link: t SELECT FROM 
subtree ■> 

BEGIN OPEN i: (tb+1 ink. index) ; 
IF i.name # item THEN error[]; 
WITH si: i.sonl SELECT FROM 
symbol ■> 
BEGIN 

sti ^ si. index; 

currentCodeLinks ^ i.codelinks; 

LoadSti[sti, IF i.son2 - empty THEN HTNuTl ELSE (stb+sti) .hti]; 
END; 
ENDCASE ■> error[]; 
END; 
ENDCASE -> error[]; 
END; 

BcdRelocations: TYPE ■ BcdBindDef s.BcdRelocations; 

relocationHead: POINTER TO BcdRelocations; 
rel: POINTER TO BcdRelocations; 

fileMap: DESCRIPTOR FOR ARRAY OF FTIndex; 

MapFile: PROCEDURE [fti: FTIndex] RETURNS [FTIndex] ■ 
BEGIN 

filelndex: CARDINAL; 
IF bed - eiocalBases THEN RETURN[fti]; 
IF fti « FTSelf THEN RETURN[bcdFi1e] 
ELSE IF fti - FTNun THEN RETURN[FTNun]; 
filelndex ♦- LOOPHOLE[f ti .CARDINAL]/SIZE[FTRecord]; 
IF fileMap[fi1eIndex] - FTNull THEN 

fi1eMap[f ilelndex] ^ BcdUtilDef s.MergeFi1e[bcd, fti]; 
RETURN[fileMap[fileIndex]] 
END; 

AllocateRelocations: PROCEDURE [type: BcdBindDef s.RelocationType] - 
BEGIN 

p: POINTER TO BcdRelocations <- BcdHeapDef s.GetSpace[SIZE[BcdRelocations]]; 
MiscDefs.Zero[p,SIZE[BcdRelocations]]; 
p. link ^ NIL; 

IF relocationHead ■ NIL THEN relocationHead ♦- rel ♦- p 
ELSE BEGIN rel.link ♦- p; rel ^ p END; 
IF (rel. type <- type) - file THEN 

BEGIN 

rel.firstgfi <- rel.lastgfi *- BcdUtilDef s.GetGf i[0]; 

rel.dummygfi <- BcdUtilDef s .GetDummyGfi[0]; 

rel, import ^ TableDef s.TableBounds[imptype].size; 
rel .importLimit <- LOOPHOLE[rel . import]; 

rel .module *- TableDef s .TableBounds[mttype].size; 

rel.config +- TableDefs .TableBounds[cttype].size; 

rel.parentcx *- CXNull; 

END 
ELSE 

BEGIN 

rel .originalf irstdummy ♦- 1; 

END; 
rel. context ^ currentCx; 
rel .textlndex ^ data. textlndex; 
rel .parameters ♦- currentParameters; 
currentParameters ♦- empty; 
RETURN 
END; 
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GetRelocationHead: PUBLIC PROCEDURE RETURNS [POINTER TO BcdRelocations] ■ 
BEGIN 

RETURN[re1ocationHead] 
END; 

ProcessExports: ExportAssigner; 

Load: PROCEDURE [sti: STIndex. name: HTIndex] 
RETURNS [map: BcdTabDef s.STMap] ■ 
BEGIN 

cantopen: STRING ^ "cannot be opened"L; 
fti: FTIndex ■ Fi1eForSti[sti]; 
i. nFiles: CARDINAL; 
BEGIN 
IF fti ■ FTNun THEN 

BEGIN 

NotLoadab1e[SIGNAL BcdErrorDefs.GetStI]; 

GOTO return 

END; 
IF fti » data.outputfti THEN 

BcdErrorDefs.Error[error, "Output file referenced as input"L]; 
LoadBcd[fti I BcdFileDefs.UnknownFile ■> 

BEGIN 

BcdErrorDefs.ErrorFile[error, cantopen, fti]; 

GOTO return 

END]; 
CheckInternalName[sti]; 
EXITS return -> RETURN [[unknown[]]]; 
END; 

nFiles <- LOOPHOLE[limits.ft.CARDINAL]/SIZE[FTRecord]; 
fileMap ^ DESCRIPTOR[BcdHeapDef s .G0tSpace[nFiles]. nFiles]; 
FOR i IN [O..LENGTH[fileMap]) DO fileMap[i] ^ FTNull ENDLOOP; 
IF limits. ct # FIRST[CTIndex] THEN 

BEGIN 

map *- [config[L00PHOLE[TableDefs.TableBounds[cttype].size]]]; 

LoadConf igs[name]; 

name <- HTNull 

END 
ELSE map ♦- [module[LOOPHOLE[TableD0f s.TableBounds[mttype]. size]]]; 
LoadModul es[name] ; 
ProcessExports[]; 
ProcessImports[]; 

rel.lastgfi ♦- BcdUtilDefs.GetGf i[0]-l; 

rel . importLimit ^ LOOPHOLE [ Tab 1 eDef s. Tab leBounds[ imp type]. size] ; 
UnloadBcd[]; 

BcdHeapDefs.FreeSpace[BASE[fileMap]]; 
END; 

ChecklnternalName: PROCEDURE [sti: STIndex] - 
BEGIN 
iname: NameRecord ■ 

IF limits. ct - FIRST[CTIndex] THEN (bed. mtb+FIRST[MTIndex]) .name 

ELSE ( bed. ctb+FIRST[CTIndex]). name; 
ihti: HTIndex « BcdUtilDef s . HtiForName[bcd, iname]; 
IF ihti If (stb+sti).hti THEN 

BcdErrorDefs.ErrorSti[error, "does not name a module or conf iguration"L. sti]; 
RETURN 
END; 

bcdSegment: SegmentDefs.FileSegmentHandle; 
bcdFile: FTIndex; 

LoadBcd: PROCEDURE [fti: FTIndex] - 
BEGIN OPEN SegmentDefs; 
pages: CARDINAL; 
bHeader: POINTER TO BCD; 
Swap In[ bcdSegment ♦- NewFileSegm0nt[BcdFileDef s.HandleForFile[fti], 

1, 1, Read]]; 
bHeader <- FileSegmentAddress[bcdSegment]; 
IF bHeader. versionident # BcdDef s.VersionID OR bHeader .definitions THEN 

BEGIN 

Unlock[bcdSegment] ; 

Del eteFileSegment[ bcdSegment]; 

bcdSegment *- NIL; 

ERROR BcdFileOefs.UnknownFile[fti]; 
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END; 
IF (pages^bHeader.nPages) # 1 THEN 

BEGIN 

Un1ock[bcdSegment]; 

MoveFileSegment[bcdSegment,bcdS8gment. base, pages]; 

SwapIn[bcdSegment] ; 

bHeader ♦- FneSegmentAddress[bcdSegnient]; 

END; 
bcdFlle <- fti; 

BcdUtilDefs.SetFileVersion[fti. bHeader. vers ion]; 
bed ^ BcdHeapDefs.GetSpace[SIZE[BcdUtilDefs.BcdBases]]; 
bcdt ♦- [ 



ctb: LOOPHOLE 
mtb: LOOPHOLE 



bHeader+bHeader.ctOffset], 
bHeader+bHeader.mtOffset], 



etb: LOOPHOLE[bHeader+bHeader.expOffset], 

itb: LOOPHOLE[bHeader+bHeader.iinpOffset]. 

sgb: LOOPHOLE[bHeader+bHeader.sgOffset]. 

ftb: LOOPHOLE[bHeader+bHeader.ftOffset]. 

ssb: LOOPHOLE[bHeader+bHeader.ssOffset], 

ntb: LOOPHOLE[bHeader+bHeader.ntOffset]]; 
limits <- [ 

ct; bHeader. ctLimit, 

sg: bHeader. sgLimit, 

ft: bHeader. ftLimit. 

mt: bHeader. mtLimit, 

et: bHeader. expLimit, 

it: bHeader. impLimit, 

nt: bHeader. ntLimit]; 
All ocateRelocat ions [file]; 
rel .originalf irstdummy ^ bHeader. firstdummy; 
RETURN 
END; 

UnloadBcd: PROCEDURE ■ 
BEGIN OPEN SegmentDefs; 
file: FileHandle ■ bcdSegment.f ile; 
Un1ock[bcdSeginent]; 
De1eteFileSegnient[bcdSegnient]; 
bcdSegment <- NIL; 
BcdHeapDef s . FreeSpace[bcd] ; 
bed <- QlocalBases; 
RETURN 
END; 

EnumerateConfigurations: PROCEDURE [proe: PROCEDURE [CTIndex]] ■ 
BEGIN 

eti: CTIndex; 
eti ^ FIRST[CTIndex]; 
UNTIL eti ■ limits. ct DO 

proc[cti]; 

eti ^ eti + SIZE[CTRecord]; 

ENDLOOP; 
RETURN 
END; 

LoadConfigs: PROCEDURE [name: HTIndex] ■ 
BEGIN 

LoadOne: PROCEDURE [eti: CTIndex] ■ 
BEGIN 

neweti: CTIndex «- BcdUtilDef s.EnterConf ig[bed , eti, name]; 
BEGIN OPEN new: localBases . etb+neweti ; 
name ♦- HTNull ; 

IF new.config » CTNull THEN new.eonfig ^ eurrentCti 
ELSE new.eonfig ♦- new.eonfig + rel.eonfig; 
new. file *- MapFile[new.f ile]; 
IF new.eontrol # MTNull THEN 

new.eontrol ^ new.eontrol + rel. module; 
END; 
END; 
EnumerateConfigurations [LoadOne]; 
RETURN 
END; 

EnumerateModules: PROCEDURE [proe: PROCEDURE [MTIndex] RETURNS [BOOLEAN]] 
RETURNS [mti: MTIndex] - 
BEGIN 
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mti ^ FIRST[MTIndex]: 
UNTIL mti ■ limits. mt DO 

IF proc[mti] THEN RETURN; 

mti *- mti + SIZE[MTRecord] + (bed, mtb+mti) .frame. length; 

ENDLOOP; 
RETURN[MTNull] 
END; 

CheckPacking: PROCEDURE [mti: MTIndex] ■ 
BEGIN 

sti: STIndex; 

name: NameRecord ■ (localBases. mtb+mti) .name; 
FOR sti ^ packSti, (stb+sti ) .link UNTIL sti - STNull DO 
IF BcdUtilDefs.NameForSti[sti] - name THEN 
BEGIN 
(stb+sti) .body ♦- external[ 

map:[module[mti]], pointer: f ile[(localBases.mtb+mti) .f ile]]; 
EXIT; 
END; 
ENDLOOP; 
RETURN 
END; 

MapSegment: PROCEDURE [oldsgi: SGIndex] RETURNS [SGIndex] ■ 
BEGIN 

seg: SGRecord <- (bcd.sgb+oldsgi)t; 
seg.file ^ MapFile[seg.f ile]; 
RETURN[BcdUtilDefs.EnterSegment[seg]] 
END; 

LoadModules: PROCEDURE [name: HTIndex] - 
BEGIN 

LoadOne: PROCEDURE [mti: MTIndex] RETURNS [BOOLEAN] - 
BEGIN 

newmti: MTIndex ^ BcdUtilDefs.EnterModule[bcd , mti, name]; 
BEGIN OPEN new: localBases. mtb+newmti ; 
name <- HTNull ; 

IF new.config ■ CTNull THEN new.config ^ currentCti 
ELSE new.config ♦- new.config + rel.config; 
new.gfi <- BcdUtilDefs.GetGf i[new.ngf i]; 
new. file ^ MapFile[new.f ile]; 
new. code. sgi *- MapSegment[new,code.sgi]; 
new.sseg ♦- MapSegment[new.sseg]; 
CheckPacking[ newmti]; 

IF currentCodeLinks THEN new. links ♦- code; 
END; 
data.nModules ^ data.nModules + 1; 
RETURN[FALSE] 
END; 
[] ^ EnumerateModules[LoadOne]; 
RETURN 
END; 

Processlmports: PROCEDURE - 
BEGIN 

newimpi, impi: IMPIndex; 
sti: STIndex; 

[impi, sti] <- FirstImport[]; 
UNTIL impi « IMPNull DO 

OPEN new: localBases. itb+newimpi ; 

newimpi <- BcdUtilDefs.EnterImport[bcd, impi, HTNull]; 

new. file <- MapFile[new.f ile]; 

[] <r BcdUtilDefs.GetDummyGf i[new.ngf i]; 

[impi, sti] <- NextImport[impi , sti]; 

ENDLOOP; 
RETURN 
END; 

nextLocalGfi: CARDINAL; 

GetLocalGfi: PROCEDURE [n: CARDINAL] RETURNS [gfi: GFTIndex] - 
BEGIN 

gfi ^ nextLocalGfi; 
nextLocalGfi <- nextLocalGfi + n; 
[] <r BcdUtilDefs.GetDummyGf i[n]; 
END; 
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ProcessLocallmports: PROCEDURE [start: IMPIndex] ■ 
BEGIN 

newimpi, impi: IMPIndex; 
sti: STIndex; 
Cantlmport: PROCEDURE ■ 
BEGIN 

BcdErrorDefs.ErrorSti[error. "Cannot be IMPORTed"L, sti]; 
END; 
nextLocalGfi ^ 1; 
[impi. sti] <- FirstImport[]; 
UNTIL sti - STNun DO 
OPEN new: localBases. itb+newimpi ; 
WITH s:stb+sti SELECT FROM 

unknown ■> Dec1areImportByName[sti , start]; 
external "^y 

WITH m:s.map SELECT FROM 

interface ■> DeclareImport[sti , m.expi]; 
unknown ■> DeclareImportByName[sti , start]; 
ENDCASE -> error[]; 
ENDCASE ■> error[]; 
[impi, sti] <- NextImport[impi , sti]; 
ENDLOOP; 
RETURN 
END; 

DeclarelmportByName: PROCEDURE [sti: STIndex, start: IMPIndex] ■ 
BEGIN 

name: NameRecord; 
impi: IMPIndex; 
maxngf i: [1, .4] <- 1; 
firstimpi: IMPIndex *- IMPNull; 

impLimit: IMPIndex - LOOPHOLE[TableDef s.Tab1eBounds[imptype].size]; 
WITH s:stb+sti SELECT FROM 
external ■> 

WITH p:s SELECT FROM 

file ■> name ♦- BcdUtilDef s.NameForSti[sti]; 
instance ■> name ^ BcdUtilDef s.NameForSti[p. sti]; 
ENDCASE -> error[]; 
unknown -> name *- BcdUtilDefs.NameForSti[sti]; 
ENDCASE -> error[]; 
FOR impi ^ start, impi+SIZE[IMPRecord] UNTIL impi - impLimit DO 
IF (localBases. itb+impi) .name ■ name THEN 
BEGIN 

IF firstimpi ■ IMPNull THEN firstimpi <- impi; 
maxngfi ♦- MAX[maxngfi, (localBases. itb+impi).ngfi]; 
END; 
ENDLOOP; 
IF firstimpi ■ IMPNull THEN 
BEGIN 

BcdErrorDefs.ErrorName[warning, "is not IMPORTed by any modules"L.name]; 
(stb+sti) .imported *- FALSE; 
RETURN 
END; 
(stb+sti) .impi <- impi ♦■ 

BcdUtilDefs. En terImport[61ocal Bases, firstimpi, HTNull]; 
(localBases. itb+impi) .ngfi <- maxngfi; 
(localBases. itb+impi) .gfi <- GetLocalGf i[maxngf i]; 
WITH s:stb+sti SELECT FROM 

unknown -> (stb+sti) .body <- external[ 
map:[unknown[]], 

pointer :file[( localBases. itb+impi) .file]]; 
ENDCASE; 
END; 

Declarelmport: PROCEDURE [sti: STIndex, expi: EXPIndex] - 
BEGIN OPEN localBases. exp: localBases. etb+expi ; 
impi: IMPIndex ♦- TableDef s . Al locate[imptype, SIZE[IMPRecord]]; 
(itb+impi)t ♦- [ 

port: interface, 

namedinstance: FALSE, 

file: exp. file. 

ngfi: (exp.size+EPLimit-l)/EPLimit. 

name: . 

gfi:]; 

(itb+impi). name ^ BcdUtilDefs. NameForSti[sti]; 
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(itb+inipi).gfi ^ GetLocalGf i[(itb+1mp1) .ngf 1]; 
(stb+sti) .imp1 ♦- Impi; 
WITH s:stb+st1 SELECT FROM 

unknown ■> (stb+sti) .body ^ external[ 
map:[unknown[]], 
pointer:f ile[exp.f He]]; 
ENOCASE; 
RETURN 
END; 

Lookup: PROCEDURE [hti: HTIndex] RETURNS [stl : STIndex] ■ 
BEGIN 

last: STIndex; 

IF hti ■ HTNun THEN RETURN[STNun]; 
FOR sti ^ (cxb+currentCx).link, (stb+sti) .1 ink UNTIL sti ■ STNull DO 

IF (stb+sti). hti ■ hti THEN RETURN; 

last <- sti; 

ENDLOOP; 
sti <- BcdUtilDefs.NewSemanticEntry[hti]; 
(stb+sti). hti <- hti; 
(stb+last).link ^ sti; 
RETURN 
END; 

Firstlmport: PROCEDURE RETURNS [IMPIndex, STIndex] ■ 
BEGIN OPEN localBases; 
sti: STIndex; 
IF loadCx - CXNull THEN 
RETURN[ 

IF limits.it ■ FIRST[IMPIndex] THEN IMPNull ELSE FIRSTCIMPIndex], 
STNull]; 
FOR sti ^ (cxb+loadCx).link, (stb+sti) . 1 ink UNTIL sti - STNull DO 
IF (stb+sti). imported THEN RETURN[IMPNull .sti]; 
ENDLOOP; 
RETURN[IMPNull, STNull] 
END; 

Nextlmport: PROCEDURE [impi: IMPIndex, sti: STIndex] 
RETURNS [IMPIndex, STIndex] - 
BEGIN OPEN localBases; 
IF loadCx " CXNull THEN 

BEGIN 

IF impi - IMPNull THEN RETURN [impi, sti]; 

impi <- impi + SIZE[IMPRecord]; 

IF impi ■ limits.it THEN impi ^ IMPNull; 

RETURN[impi, STNull]; 

END; 
IF sti - STNull THEN RETURN [impi, sti]; 
UNTIL (sti 4- (stb+sti). link) ■ STNull DO 

IF (stb+sti). imported THEN RETURN[IMPNul 1 ,sti] 

ENDLOOP; 
RETURN[IMPNull, STNull] 
END; 

Portableltem: TYPE ■ RECORD [ 
SELECT type: ♦ FROM 

interface «> [expi : EXPIndex], 

module =«> [mti: MTIndex], 

unknown »> [name: HTIndex], 

null -> [fill: TableDefs.Tablelndex], 

ENDCASE]; 

PortNull: Portableltem - [nul l[EXPNull]]; 

HtiForPortable: PROCEDURE [p: Portableltem] RETURNS [HTIndex] - 
BEGIN OPEN BcdUtilDefs; 
WITH p SELECT FROM 

interface «> RETURN[HtiForName[bcd, (bed. etb+expi) .name]]; 

module «> RETURN[HtiForName[bcd, (bed. mtb+mti) .name]]; 

ENDCASE; 
RETURN[HTNun] 
END; 

EnumerateExports: PROCEDURE [proc: PROCEDURE [Portableltem]] 
RETURNS [Portableltem] ■ 
BEGIN OPEN localBases; 
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eti: EXPIndex; 
PassItOn: TreeScan ■ 
BEGIN 

sti: STIndex; 
WITH t SELECT FROM 

symbol ■> sti ♦- index; 

subtree ■> WITH (tb+index) .sonl SELECT FROM 
symbol ■> sti *- index; 
ENDCASE -> errorC]; 
ENDCASE -> error[]; 
IF -(stb+sti). exported THEN RETURN; 
WITH s:stb+sti SELECT FROM 
external "^ 

WITH m:s.map SELECT FROM 

interface ■> proc[[interface[m.expi]]]; 
module ■> proc[[module[m.mti]]]; 
ENDCASE -> proc[[unknownCs.hti]]]; 
ENDCASE ■> proc[[unlcnown[s.hti]]]; 
END; 

SELECT TRUE FROM 

(loadExpi # EXPNull) ■> proc[[interf aceCloadExpi]]]; 
(loadTree ■ nullTreelndex) ■> 

FOR eti <r FIRSTCEXPIndex], eti+SIZE[EXPRecord]+(bcd.etb+eti) .size 
UNTIL eti « limits. et DO 
proc[[interface[eti]]]; 
ENDLOOP; 
ENDCASE ■> scanlist[(tb+loadTree).son2. PassItOn]; 
RETURN[PortNull] 
END; 

VerifyExports: ExportAssigner ■ 
BEGIN 

ExportOne: PROCEDURE [p: Portableltem] ■ 
BEGIN 

WITH p SELECT FROM 
unknown ■> 
BEGIN 

BcdErrorDef s.ErrorHti[warning, "is not EXPORTed by any modules"L, name]; 
RETURN; 
END; 
ENDCASE; 
END; 
[] <- EnumerateExports[ExportOne]; 
RETURN 
END; 

NormalExports: ExportAssigner ■ 
BEGIN 
ExportOne: PROCEDURE [p: Portableltem] - 

BEGIN 

CombineExport[ 

Lookup[HtiForPortable[p]]» p, currentOp]; 

END; 
[] <- EnumerateExports[ExportOne]; 
RETURN 
END; 

Ihs: TreeLink; 

AssignedExports: ExportAssigner ■ 
BEGIN 

port: TYPE - MACHINE DEPENDENT RECORDCin.out : UNSPECIFIED]; 
left: PORT [TreeLink] RETURNS [TreeLink]; 
right: PORT RETURNS [Portableltem]; 
t: TreeLink; 
p: Portableltem; 

LOOPHOLE[left, port]. out ^ updatelist; 
LOOPHOLE[right, port], out ♦- EnumerateExports; 

t ^ LOOPHOLE[left,PORT[TreeLink, POINTER] RETURNS [TreeLink]][lhs. ©left]; 
p <r LOOPHOLE[right,PORT[POINTER] RETURNS [PortableItem]][0right]; 
DO 

WITH t SELECT FROM 

symbol -> CombineExport[index, p, currentOp]; 

subtree -> 

BEGIN OPEN tb+index; 
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IF name # Item THEN error[]; 
WITH sonl SELECT FROM 

symbol ■> CombineExport[inclex, p. currentOp]; 
ENDCASE ■> error[]; 
END; 
ENDCASE ■> errorC]; 
t ♦- 1eft[t]; 
p ^ right[]; 
IF t - Ihs THEN 
BEGIN 

IF p - PortNull THEN EXIT; 

BcclErrorDefs.Error[error, "Too many exports 1n right hand side of assignmenf'L]; 
UNTIL p ■ PortNull DO p ^ right[] ENDLOOP; 
EXIT 
END; 
IF p - PortNull THEN 
BEGIN 

BcdErrorDefs.Error[error, "Too few exports in right hand side of assignment"L]; 
UNTIL t - Ihs DO t 4- left[t] ENDLOOP; 
EXIT 
END; 
ENDLOOP; 
RETURN 
END; 

LoadAssign: PROCEDURE [t: Treelndex] ■ 
BEGIN 

saveAssigner: ExportAssigner *- ProcessExports; 
ProcessExports ♦■ AssignedExports; 
Ihs ^ (tb+t).sonl; 
LoadExpression[(tb+t) .son 2] ; 
ProcessExports ^ saveAssigner; 
END; 

NewExport: PROCEDURE [expi: EXPIndex] RETURNS [newexpi: EXPIndex] ■ 
BEGIN 

OPEN new: localBases .etb+newexpi ; 

newexpi ♦- BcdUtilDef s.EnterExport[bcd, expi, HTNull]; 
new. file ^ MapFile[new.f ile]; 
END; 

CombineExport: PROCEDURE [sti: STIndex, p: Portableltem, op: InterfaceOp] ■ 
BEGIN 

target: FTIndex ^ FileForSti[sti]; 
WITH p SELECT FROM 
unknown -> 
BEGIN 

BcdErrorDefs.ErrorHti[warning, "is not EXPORTed by any modules"L. name]; 
RETURN; 
END; 
ENDCASE; 
IF target » FTNull THEN DeclarePortableltemfsti .p] 
ELSE IF FileForPortableltemCp] # target THEN 

BcdErrorDefs.Error2Files[error, "cannot be exported as"L, FileForPortableItem[p] .target]; 
WITH p SELECT FROM 

interface ■> CombineInterface[sti , expi, op]; 
module ■> CombineModule[sti , mti , op]; 
ENDCASE; 
RETURN 
END; 

CombineModule: PROCEDURE [sti: STIndex, mti: MTIndex, op: InterfaceOp] - 
BEGIN 

WITH s:(stb+sti) SELECT FROM 
extfipnfll '• ^ 

WITH m:s.map SELECT FROM 
module ■> 

IF m.mti - MTNull THEN 

BEGIN m.mti ♦- mti; RETURN END 
ELSE IF op - plus THEN 

BcdErrorDefs.ErrorModule[warning, "is a duplicate export"L, m.mti]; 
unknown ■> 

s.map <- [module[BcdUtilDefs.EnterModule[bcd. mti. HTNull]]]; 
ENDCASE -> error[]; 
ENDCASE "> error[]; 
RETURN 
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END; 

Combinelnterface: PROCEDURE [sti: STIndex. eti: EXPIndex, op: InterfaceOp] ■ 
BEGIN 

1: CARDINAL; 
neweti: EXPIndex; 
WITH s:(stb+sti) SELECT FROM 
ex'terna! "^ 

WITH m:s.map SELECT FROM 
interface ■> 
BEGIN 

IF m.expi - EXPNull THEN m.expi ^ NewExport[et1]; 
neweti ^ m.expi; 
END; 
unknown ■> 
BEGIN 

neweti ♦- NewExportCeti]; 
s.map *- [interfaceCneweti]]; 
END; 
ENDCASE -> error[]; 
ENDCASE -> error[]; 
BEGIN OPEN old: bcd.etb+eti. new: localBases. etb+neweti ; 
FOR i IN [0.. old. size) DO 

IF old.1inks[i3 # NullLink THEN 
BEGIN 
IF new.1inks[i] - NullLink THEN 

new.links[i] ^ Re1ocateExportLink[o1d. 1 inks[i]] 
ELSE IF op-plus THEN 

BcdErrorDefs.ErrorItem[warning, "is a duplicate export"L, i 
I BcdErrorDefs.Getlnterface -> RESUME[neweti]]; 
END; 
ENDLOOP; 
END; 
RETURN 
END; 

RelocateExportLink: PROCEDURE [cl : ControlLink] RETURNS [ControlLink] - 
BEGIN 
IF loadExpi - EXPNull AND loadCx - CXNull THEN 

cl.gfi ^ cl.gfi + rel .f irstgf i-1; 
RETURN[cl] 
END; 

xLoadSti: PROCEDURE [sti: STIndex] ■ 
BEGIN 
WITH s: stb+sti SELECT FROM 

WITH m:s.map SELECT FROM 
interface -> 
BEGIN 

IF m.expi - EXPNull THEN errorC]; 
loadExpi ^ m.expi ; 
ProcessExports[]; 
loadExpi ♦- EXPNull; 
END; 
ENDCASE ■> LoadStiCsti.HTNull]; 
ENDCASE -> LoadSti[sti.HTNun]; 
END; 

xLoadltem: PROCEDURE [t: TreeLink] - 
BEGIN 

WITH link: t SELECT FROM 
subtree ■> 

BEGIN OPEN i: (tb+1 ink. index) ; 
IF i.name # item THEN error[]; 
WITH si: i.sonl SELECT FROM 
symbol ■> 
BEGIN 

WITH s: stb+sl. index SELECT FROM 
external "^ 

WITH m:s.map SELECT FROM 
interface ■> 
BEGIN 
xLoadSti[sl. index]; 
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RETURN 
END; 
ENDCASE; 
ENDCASE; 
LoadSti [si. Index, (stb+sl. index). hti]; 
END; 
ENDCASE ■> error[]; 
END; 
ENDCASE ■> error[]; 
END; 

LoadExpresslon: PROCEDURE [exp: TreeUnk] ■ 
BEGIN 
WITH exp SELECT FROM 

symbol ■> xLoadSti[index]; 
subtree ■> 

SELECT (tb+index).name FROM 
item ■> xLoadItem[exp]; 
module -> 
BEGIN 

currentParameters ^ (tb+1ndex) .son2; 
LoadItem[(tb+index) .sonl]; 
END; 
plus» then ■> 

BEGIN OPEN tb+index; 
LoadExpression[sonl]; 
IF name ■ then THEN currentOp ^ then; 
LoadExpression[son2]; 
currentOp <- plus; 
END; 
ENDCASE -> error[]; 
ENDCASE ■> error[]; 
RETURN 
END; 



END.. 



